home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / blankscr.zip / BLANKSCR.PAS < prev   
Pascal/Delphi Source File  |  1993-01-04  |  7KB  |  166 lines
  1. program ScreenBlanker;                      { turns off the display }
  2.                                             { and waits for a key   }
  3. {$M 16384,0,0}                              { leave the heap for appl. prgms }
  4.  
  5. uses
  6.   Dos,Crt;                                  { units we'll use }
  7. const
  8.   PortAddress :array [0..1] of integer = ($3B8,$3D8);
  9. type
  10.   VideoCardType = (Mono,CGA);               { the cards we're looking for }
  11. var
  12.   CrtModeSet :byte absolute $0040:$0065;    { current video mode kept here }
  13.   Regs :Registers;                          { predefined Type in Dos unit }
  14.   Seconds :real;                            { elapsed time since key press }
  15.   OldExit,                                  { addr of Turbo's run-time ExitProc }
  16.   Old_9_Vector,                             { address of old intr 9 vector }
  17.   Old_1C_Vector :pointer;                   { address of old intr $1C vector }
  18.   ScreenOn :boolean;                        { set to false when scr is blanked }
  19.   ErrorCode,
  20.   ClockTicks,                               { BIOS clock ticks 18.2 times/sec }
  21.   Delay :integer;                           { time to wait before blanking scr }
  22.   AddrIndex,                                { 0 = Mono, 1 = CGA }
  23.   DisplayOn,                                { bytes written to I/O port }
  24.   DisplayOff :byte;
  25.  
  26.  
  27.  
  28. procedure RestoreOldVector (IntrNumber :integer; OldVector :pointer);
  29.  
  30.   { a generic procedure which restores the old interrupt vector entry in the
  31.     interrupt vector table before exiting }
  32.  
  33.   begin
  34.     SetIntVec (IntrNumber,OldVector);
  35.   end; {procedure}
  36.  
  37.  
  38. {$F-}
  39. procedure OnExit; {$F+}                     { custom exit procedures }
  40.   begin
  41.     if ErrorCode <> 0 then
  42.       case ErrorCode of
  43.         1 :begin
  44.              Writeln;
  45.              Writeln ('Unknown video card installed.  Program Aborted.');
  46.              Write ('Please contact the author about this problem.');
  47.              Writeln;
  48.            end;
  49.         2 :begin
  50.              ClrScr;
  51.              Writeln ('Display blanking program successfully installed.  Delay: ',Delay);
  52.              Writeln;
  53.            end;
  54.         else begin                          { abnormal exit }
  55.           RestoreOldVector ($1C,Old_1C_Vector);
  56.           RestoreOldVector (9,Old_9_Vector);
  57.         end; {else}
  58.       end; {case}
  59.       ExitProc := OldExit;
  60.     end; {procedure}
  61.  
  62.  
  63. procedure WatchClock;                       { BIOS timer tick inter handler }
  64. interrupt;
  65.   procedure VideoSwitch (PortAddr :integer; DataOut :byte);
  66.     begin
  67.       Port [PortAddr] := DataOut;           { send On/Off byte to I/O port }
  68.     end; {nested procedure}
  69.   begin                                     { main procedure }
  70.     InLine ($FA);                           { disable interrupts }
  71.     ClockTicks := ClockTicks + 1;           { increment the time }
  72.     Seconds := int (ClockTicks/18.2);       { time since last key press }
  73.     if (Seconds >= Delay) and (ScreenOn) then begin
  74.                                             { turn off the display }
  75.       VideoSwitch (PortAddress [AddrIndex],DisplayOff);
  76.       ScreenOn := false;                    { set the flag- screen is off }
  77.     end {if}
  78.     else if (Seconds < Delay) and (not ScreenOn) then begin
  79.                                             { turn screen back on }
  80.       VideoSwitch (PortAddress [AddrIndex], DisplayOn);
  81.       ScreenOn := true;                     { reset the flag }
  82.     end; {else}
  83.     InLine ($FB);                           { re-enable interrupts }
  84.   end; {procedure}
  85.  
  86.  
  87. procedure WatchKeyBoard;                    { monitors keyboard via intr 9 }
  88. interrupt;
  89.   begin
  90.     InLine ( $9C/                           { PUSH AF }
  91.              $3E/$FF/$1E/Old_9_Vector       { CALL FAR DS:[OLD_9_VECTOR] }
  92.            );                               { pass keystroke to old intr 9 }
  93.     ClockTicks := 0;                        { reset counter }
  94.     Seconds := 0;
  95.   end; {procedure}
  96.  
  97.  
  98. function GetVideoCard :VideoCardType;
  99.   { returns the video controller hardware configuration }
  100.   begin
  101.     Intr ($11,Regs);                        { issue the interrupt }
  102.     case Lo (Regs.ax) AND $30 of
  103.       $30  :GetVideoCard := Mono;
  104.       $20  :GetVideoCard := CGA;            { 80 column text }
  105.       $10  :GetVideoCard := CGA;            { 40 column text }
  106.       else begin                            { video card unknown }
  107.         Writeln;
  108.         Writeln ('Unknown video card installed.  Program Aborted.');
  109.         Write ('Please contact the author about this problem.');
  110.         Writeln;
  111.         Halt;
  112.       end; {else}
  113.     end; {case}
  114.   end; {function}
  115.  
  116.  
  117. procedure Initialize;
  118.   begin
  119.     if ParamCount > 0 then                  { get delay time }
  120.       val (ParamStr (1),Delay,ErrorCode)
  121.     else Delay := 5;                        { default delay- 5 min }
  122.     Delay := Delay * 60;                    { convert delay to seconds }
  123.     ClockTicks := 0;                        { init variables }
  124.     Seconds := 0;
  125.     ScreenOn := true;
  126.     OldExit := ExitProc;                    { save old exit procedure address }
  127.     ExitProc := @OnExit;                    { insert custom exit procedure }
  128.  
  129.     Inline                                  { clear the key buffer }
  130.     ($B4/$06/                               { L1: MOV  AH,6    ;function }
  131.      $B2/$FF/                               {     MOV  DL,0FFH ;subfunction }
  132.      $CD/$21/                               {     INT  21H     ;key in buffer? }
  133.      $75/$F8);                              {     JNZ  L1      ;repeat if yes }
  134.  
  135.     case GetVideoCard of                    { set byte to send to I/O port }
  136.       Mono :begin                           { Mono card }
  137.               DisplayOff := $21;
  138.               DisplayOn := $29;
  139.               AddrIndex := 0;
  140.             end;
  141.       CGA  :begin                           { CGA }
  142.               DisplayOff := CrtModeSet AND $F7;
  143.               DisplayOn := CrtModeSet;
  144.               AddrIndex := 1;
  145.             end;
  146.     end; {case}
  147.  
  148.     GetIntVec ($1C,Old_1C_Vector);          { save orig. intr $1C vector }
  149.     SetIntVec ($1C,@WatchClock);            { install the new $1C handler }
  150.     GetIntVec (9,Old_9_Vector);             { save orig intr 9 vector }
  151.     SetIntVec (9,@WatchKeyBoard);           { install new intr 9 handler }
  152.   end; {procedure}
  153.  
  154.  
  155.  
  156. begin                                       { main program }
  157.   Initialize;
  158.   Writeln;
  159.   Writeln ('Display blanking program successfully installed.  Delay: ',
  160.             Delay div 60,' minute(s).');
  161.   Writeln;
  162.   Keep (2);
  163.   RestoreOldVector ($1C,Old_1C_Vector);
  164.   RestoreOldVector (9,Old_9_Vector);
  165. end. {program}
  166.